perm filename MSFAI.FAI[NEW,LCS] blob
sn#592287 filedate 1981-06-09 generic text, type T, neo UTF8
;*** SUBROUTINES FROM MS.F4
;*** DISAPR, INSCOR, ZOOM, ESPOS
TITLE MSFAI
INTERNAL DISAPR,INSCOR,ZOOM,EDCEN
EXTERNAL .COMM.,LIMIT,XRN,DL,RRJJ,DPY,PTR,CHK,SCM,RMOD,SIZ
EXTERNAL STF,POSI,ALF,A2Z,DPTR,YED,JCLIP,JCHAR,FONT,ZCRSOR,AMOD
EXTERNAL DPYDO,ACCPOG,SCMSS,SHRINK,SCMSS,HOMX,SCL,HYDPOG
; INTEGER FUNCTION DISAPR(DP); DIMENSION DP(0/7)
; COMMON R2,JA,CENTR,J2,RJQ(20)
DISAPR: 0 ; DISAPR=0
SETZ ; IF(R2.GT.7)GO TO 620
MOVE 2,(16) ;GET LOC OF DP ARRAY
; GO BACK AND RESET ALL IF STF NUM >7
KIFIX 1,.COMM. ;K=R2
CAILE 1,7 ;JA=0
JRST DIS620
SETZ 3, ;JA ;IF(K.GE.0)GO TO 610
JUMPGE 1,DIS610
MOVEI 1,7 ;C TYPE DP -1 FOR ALL INVISIBLE
DIS611: SETOM (2) ;DO 611 K=0,7
AOJ 2,
SOJGE 1,DIS611 ;611 DP(K)=-1
DIS1: JRA 16,1(16) ;RETURN
DIS610: CAILE 1,=8 ;IF(K.GT.8)GO TO 1320
JRST DS1320 ;C END WITH ANY NUMBER >8 TO CAUSE NEW DPY
CAIN 1,=8 ;610 IF(K.EQ.8)K=0
SETZ 1,
ADD 1,(16) ;GET LOC OF DP ARRAY
MOVNS (1) ;DP(K)=-DP(K)
AOJ 3, ;JA=JA+1
KIFIX 1,.COMM.+3(3) ;K=RJQ(JA)
JUMPE 1,DIS1 ;IF(K.EQ.0)RETURN
;; CAIN 1,=99 ;C JUMP OUT IF RJQ(JA)=0 OR 99
;; JRST DS1320 ;IF(K.EQ.99)GO TO 1320
;*** 3/74 END WITH '99' TO MAKE DP RIGHT NOW!
JRST DIS610 ;GO TO 610
DIS620: MOVEI 1,7
MOVEI 0,1
DIS630: MOVEM 0,(2) ;620 DO 630 K=0,7
AOJ 2, ;630 DP(K)=1
SOJGE 1,DIS630
DS1320: SETOM ;1320 DISAPR=-1
JRA 16,1(16) ;C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
; FUNCTION INSCOR(SCORE)
; IMPLICIT INTEGER(A-Q,S-Z)
; COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
; COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
; 1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO
; 1 /PTR/PWDS(350) /CHK/ICHK,ITCHK,JIT,SPD,IDPY,M
; 3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
; 2 /RMOD/RMODE2,RSET4,IBEAM
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
; EQUIVALENCE (ST2,ST(2))
INSCOR: 0 ; INSCOR=0
SKIPGE SCM+=281 ; IF(REND.LT.0)GO TO 1050
JRST IN1050 ;C REND=0 GO, -1=NORMAL END, 1=ABORTED.
JSA 16,SCMSS ;CALL SCMSS
SETZM DL+4 ;IOLD=0
MOVE 1,SCM+=281 ; IF(REND.EQ.1)GO TO 1050
CAMN 1,[1.0] ; IF(REND.NE.99)GO TO 1020
JRST IN1050
CAME 1,[99.0]
JRST IN1020
MOVE CHK ;I=ICHK
MOVEM LIMIT+3
MOVE CHK+1 ;ITEM=ITCHK
MOVEM LIMIT+1
MOVE CHK+4 ;ST2=IDPY
MOVEM DPY+1
JSA 16,ACCPOG ;CALL ACCPOG(1)
JUMP [1]
JSA 16,DPYDO ;CALL DPYDO(1)
JUMP [1]
JRST IN1050 ;GO TO 1050
IN1020: MOVE CHK+2 ;1020 ITEM=JIT
MOVEM LIMIT+1
MOVE 1,CHK+5 ;J=M
IN1030: AOS LIMIT+1 ;1030 ITEM=ITEM+1
MOVE 2,LIMIT+1 ;PWDS(ITEM)=J
MOVEM 1,PTR-1(2)
KIFIX 3,XRN-1(1)
ADDI 3,3
ADD 1,3 ;J=J+RN(J)+3
CAMGE 1,LIMIT+3 ;IF(J.LT.I)GO TO 1030
JRST IN1030
SKIPGE RMOD+2 ;IF(IBEAM)GO TO 1040
JRST IN1040
MOVE SCM+=80 ;R2=RSTF
MOVEM .COMM.
SETOM .COMM.+1 ;JA=-1
JSA 16,HOMX ;CALL HOMX
;C GO ADJUST STEM LENGTHS
IN1040: MOVE CHK+2 ;1040 ITEM=JIT
MOVEM LIMIT+1
MOVE CHK+3 ;ST2=SPD
MOVEM DPY+1
SETZ ;(INSCOR=0)
JRA 16,1(16) ;RETURN
IN1050: SETOM @(16)
JSA 16,SHRINK ;1050 SCORE=-1
JUMP CHK+2 ;CALL SHRINK(JIT)
; GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
SETOM DPY+=4001 ;IGO=-1
MOVEI =16 ;JA=16
MOVEM .COMM.+1 ;C FOR TRAP AT 'EDIT'
SETO ;INSCOR=-1
JRA 16,1(16)
RZMSZ: [1.0] ; DATA RZMSZ/1.0/,RZMX/50.0/,RZMY/50.0/
RZMX: [50.0];DATA STATEMENT NEEDED TO GET CORRECT NUMS. FOR ZU,ZD, ETC. BEFORE Z1, ETC.
RZMY: [50.0]
RZZZ: 0
ZOOM: 0 ; SUBROUTINE ZOOM
;C** CALLS SCL, ZCRSOR
; IMPLICIT INTEGER(A-Q,S-Z)
; REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
; COMMON /SIZ/RSZ,JCEN,KCEN
; COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
; 1 /STF/RSTFAC(0/7),RSTJ2 /FONT/JFONT
; 2 /POSI/STFF(0/7),JJ2,POS /ALF/INP(72),ML
; COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
; 1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
; 1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO /DPTR/WDS(350)
; 2 /YED/YED,IBOX,RBOX/JCLIP/JCLIP
; EQUIVALENCE (R5,RJQ(3)),(R4,RJQ(2))
; 2 ,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1))
; 'Z' = ZOOM CAN'T DO ZOOM WHILE IN EDIT MODE
MOVE 1,ALF+1 ;IF(I2.NE.LDD.AND.I2.NE.LUU)CALL HYDPOG(2)
CAME 1,A2Z+3 ;C CLEAR SPACING SCALE IF NOT MOVING UP OR DOWN.
CAMN 1,A2Z+=20
JRST ZM1
JSA 16,HYDPOG
JUMP [2]
ZM1: MOVEI =24 ; JA=24
MOVEM .COMM.+1
SETZM DPY+=4001 ;IGO=0
ZM1180: MOVE 2,.COMM. ;1180 IF(R2.LT.200)GO TO 1190
CAMGE 2,[200.0]
JRST ZM1190
JSA 16,AMOD ;R3=AMOD(R2,100.)
JUMP .COMM.
JUMP [100.0]
MOVEM .COMM.+4
FSBR 0,.COMM. ;R2=(R2-R3)/100.
FDVR 0,[100.0]
MOVNM 0,.COMM.
MOVE 2,[9.0] ;R4=5*IFIX(9.0/R2)
FDVR 2,.COMM. ;C Z240 GIVES 2 40 20. Z366 GIVES 3 66 15. Z490 GIVES 4 90 10.
KIFIX 2,2
IMULI 2,5
FLTR 2,2
MOVEM 2,.COMM.+5
ZM1190: MOVE 2,.COMM.+4 ;1190 IF(R2.GT.1.OR.R3+R4.NE.0)GO TO 1195
FADR 2,.COMM.+5
JUMPN 2,ZM1195
MOVE 2,.COMM.
CAMLE 2,[1.0]
JRST ZM1195
MOVE [50.0] ;R3=50.0
MOVEM .COMM.+4
MOVEM .COMM.+5 ;R4=50.0
ZM1195: SKIPLE 4,ALF+1 ;Z1 ONLY ADDS IN 50,50 SO WE CAN ZOOM UP AND DOWN AT ANY SIZE.
JRST ZM1250 ;1195 IF(I2.GT.0)GO TO 1250
MOVE 1,.COMM. ;NEXT SECTION FOR ZLn, ZRn, ZUn, ZDn. n=% OF SCREEN CHANGE OF CENTER PO
MOVEM 1,.COMM.+4 ;R3=R2
JUMPN 1,ZM2 ;CRR*** ABOVE REPLACES REREAD
MOVE RZZZ ;IF(R3.EQ.0)R3=RZZZ
MOVEM .COMM.+4
ZM2: MOVE .COMM.+4 ;RZZZ=R3
MOVEM RZZZ ;C SAVE R3 FOR REPEAT OF COMMAND WITHOUT n.
FDVR RZMSZ ;R3=R3/RZMSZ
MOVEM .COMM.+4 ;'ZR10' MEANS MOVE CENTER OF IMAGE 10% OF SCREEN SIZE TO RIGHT.
CAME 4,A2Z+=17 ;IF(I2.NE.LRR)GO TO 1220
JRST ZM1220
MOVNS .COMM.+4 ;R3=-R3
ZM1200: MOVE RZMX ;1200 R3=RZMX+R3
FADRM .COMM.+4
MOVE RZMY ;R4=RZMY
MOVEM .COMM.+5
ZM1210: MOVE RZMSZ ;1210 R2=RZMSZ
MOVEM .COMM.
JRST ZM1290 ;GO TO 1290
ZM1220: CAMN 4,A2Z+=11 ;1220 IF(I2.EQ.LEL)GO TO 1200
JRST ZM1200
CAME 4,A2Z+=20 ;IF(I2.NE.LUU)GO TO 1240
JRST ZM1240
MOVNS .COMM.+4 ;R3=-R3
ZM1230: MOVE .COMM.+4 ;1230 R4=RZMY+R3
FADR RZMY
MOVEM .COMM.+5
MOVE RZMX ;R3=RZMX
MOVEM .COMM.+4
SETZM ALF ;I1=0
JRST ZM1210 ;C I1=0 STOPS REDRAWING OF SPACING SCALE FOR UP-DOWN ZOOMS
;;ZM1240: MOVE ALF+1 ; GO TO 1210
ZM1240: CAMN 4,A2Z+3 ;1240 IF(I2.EQ.LDD)GO TO 1230
JRST ZM1230 ;1250 JCLIP=525
ZM1250: MOVEI =525 ;C SETS CLIP LIMITS IN CLIP SUBR.
MOVEM JCLIP
SKIPE .COMM. ;IF(R2.NE.0)GO TO 1270
JRST ZM1270
CAMN 4,A2Z+=25 ;IF(I2.EQ.LZZ)GO TO 1280
JRST ZM1280
SETOM DPY+=4001 ;IGO=-1
ZM1260: MOVE [1.0] ;1260 R2=1.
MOVEM .COMM. ;C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
ZM1270: MOVE .COMM. ;1270 IF(R2.LE.1)GO TO 1290
CAMG [1.0]
JRST ZM1290
MOVEI =511 ;JCLIP=511
MOVEM JCLIP
SKIPE .COMM.+4 ;IF(R3.NE.0)GO TO 1290
JRST ZM1290
ZM1280: JSA 16,ZCRSOR ;1280 CALL ZCRSOR
ZM1290: MOVE 1,.COMM. ;'Zn' (AND NO OTHER NUM) WHERE n >1 ALLOWS YOU SET CENTER WITH LIGHTPEN
FMPR 1,[0.845] ;1290 RSZ=.845*R2
MOVEM 1,SIZ
MOVE .COMM. ; RZMSZ=R2
MOVEM RZMSZ
MOVE 3,.COMM.+4 ;RZMX=R3
MOVEM 3,RZMX
MOVE 4,.COMM.+5 ; RZMY=R4
MOVEM 4,RZMY ;C REMEMBER FACTORS
FMPR 3,[10.0] ;JCEN=(R3*10-500)*RSZ
FSBR 3,[500.0]
FMPR 3,SIZ
KIFIX 3,3
MOVEM 3,SIZ+1
FMPR 4,[10.0] ;KCEN=(R4*10-480)*RSZ
FSBR 4,[480.0]
FMPR 4,SIZ
KIFIX 4,4
MOVEM 4,SIZ+2
;ZM1300: MOVE 2,.COMM.+5 ;C NEXT TO RECONSTITUTE SPACING SCALE.
; FSBR 2,[100.0] ;1300 R2=(R4-100.)/100.
; FDVR 2,[100.0] ;C%%%%%%%%%%%%%
; SKIPGE 2 ;IF(R2.LT.0)R2=0
; SETZ 2, ;C WE DON'T WORRY IF IT'S TOO HIGH (YET).
; MOVEM 2,.COMM.
ZM1310: SETZM .COMM.+5 ;1310 R4=0
SETZM .COMM. ;R2=0
MOVE RZMSZ ;IF(RZMSZ.LE.1)GO TO 1315
CAMG [1.0] ;C PUT UP SPACING SCALE ABOVE STAFF 1 FOR ZOOMS .GT.1
JRST ZM1315 ;R2=1
MOVE [1.0]
MOVEM .COMM.
SKIPE ALF ;IF(I1.NE.0)CALL SCL
JSA 16,SCL
SETZM .COMM. ; R2=0
ZM1315: SETZM .COMM.+4 ;1315 R3=0
SETZM .COMM.+5 ;R4=0
; IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
SETZM FONT ;JFONT=0
JRA 16,(16)
; SUBROUTINE EDCEN(ICB)
; COMMON R2,JA /ALF/I1,I2,I3
; COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
; 1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
EDCEN: 0 ; R2=1.
MOVE 3,@(16) ;CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
MOVEI =13 ;JA=13
MOVEM .COMM.+1
MOVE 2,[1.0] ;IF(I2.EQ.LXX)R2=0
MOVE 1,ALF+1
CAMN 1,A2Z+=23
SETZ 2,
CAMN 1,A2Z+7 ;IF(I2.EQ.LHH)R2=-R2
MOVNS 2
CAMN 1,A2Z+=19 ;IF(I2.EQ.LTT)R2=-2.
MOVN 2,[2.0]
CAMN 1,A2Z+1 ;IF(I2.EQ.LBB)ICB=6
MOVEI 3,6
CAME 1,A2Z+=21 ;IF(I2.EQ.LVV.OR.I2.EQ.LDD)ICB=-1
CAMN 1,A2Z+3
SETO 3,
MOVE ALF+2 ;IF(I3.EQ.LVV)ICB=ICB-10
CAMN A2Z+=21 ;TYPE 'CB' FOR CENTER-BIG (BIG RANGE =6) ***** 'CV'=SET CURVE OF SLUR
SUBI 3,=10 ;CBV, CHV, CTV WILL SET CURVE AND DO CENTERING. CD CENTERS DASH BETWEEN WDS.
MOVEM 3,@(16)
MOVEM 2,.COMM.
JRA 16,1(16)
END